home *** CD-ROM | disk | FTP | other *** search
- SUBROUTINE PUTOPT(SOPT,LOPT,ICHR,IERR)
- C! Put an operator on the stack
- include 'STACK.h'
- CHARACTER*(*) SOPT
- include 'OPPREC.h'
- C
- C Here we use the operator precedence for Fortran to determine
- C whether the addition of this operator will cause the stack
- C to be reduced. Note both right and left precedence is needed.
- C Thanks to Julian Blake for this info.
- C
- IERR = 0
- DO 10 I=1,LOPS
- IF(ILENO(I).NE.LOPT) GOTO 10
- IF(SOPT(:LOPT).EQ.COPER(I)(:LOPT)) GOTO 20
- 10 CONTINUE
- IERR = 1
- C not found ... not an operator
- GOTO 30
- 20 CONTINUE
- C found. Operator number I
- IOP = I
- IPREC = IRITP(IOP)
- C
- C WRITE(6,100) NLEVL,(CTYP(I),COPD(I)(:LOPD(I)),COPT(I),
- C & IPOP(I),IPOS(I),
- C & I=NLEVL,1,-1)
- C
- C WRITE(6,110) SOPT(:LOPT),IPREC
- C
- C check if operator already present
- IF(COPT(NLEVL)(:1).NE.' ') THEN
- NLEVL = NLEVL + 1
- CTYP(NLEVL) = '$'
- COPD(NLEVL)(:LCOPD) = ' '
- LOPD(NLEVL) = 0
- COPT(NLEVL)(:LOPER) = ' '
- COPT(NLEVL)(:LOPT) = SOPT(:LOPT)
- IPOP(NLEVL) = ILEFP(IOP)
- IPOS(NLEVL) = ICHR
- IERR = 0
- GOTO 30
- ENDIF
- C place operator on stack
- COPT(NLEVL)(:LOPER) = ' '
- COPT(NLEVL)(:LOPT) = SOPT(:LOPT)
- IPOP(NLEVL) = ILEFP(IOP)
- IPOS(NLEVL) = ICHR
- C check for reduction of stack
- IF(NLEVL.EQ.1) THEN
- IERR = 0
- GOTO 30
- ENDIF
- IF(IRITP(IOP).GT.IPOP(NLEVL-1)) THEN
- IERR = 0
- GOTO 30
- ENDIF
- C expression must be reduced
- CALL REDEXP(IOP,IERR)
- IERR = -IERR
- 30 CONTINUE
- RETURN
- 500 FORMAT(///,1X,'IN PUTOPT ... STACK LEVEL = ',I2, /,1X,
- +'TYPE,OPERAND',23X,',OPERATOR,PRECEDENCE,POSITION', /,1X,
- +'---- -------',23('-'),' -------- ---------- --------', (/,1X,2X,
- +A1,2X,A30,8X,A2,6X,I2,8X,I2))
- 510 FORMAT(1X,'CURRENT OPERATOR -> ',A,' PRECEDENCE = ',I2)
- END
-